perm filename FILL.OLD[NEW,LCS]1 blob
sn#149689 filedate 1975-03-10 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES
00400 DEFINE FLOAT(N)
00500 < TLC N,232000
00600 FADR N,N >
00700 DEFINE FIXX(N)
00800 < JUMPGE N,.+5
00850 MOVNS N
00900 FIX N,233000
01000 MOVNS N
01100 CAIA
01200 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01400
01500 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01600 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01700 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01800
01900 ; SUBROUTINE FILLER(Q,M)
02000 FILLER: 0
02100 MOVEM 16,SV16#
02200 HRRZ J,(16)
02300 HRRZM J,SVQ#
02400 HRRZ T,@1(16)
02500 HRRZM T,SVM# ; KK=NE(1)
02600 HRRZ KK,2(J)
02700 ADDI KK,-1(J)
02800 ; DO 4 K=2,KK
02900 HRRZI L,2(J)
03000 ; IF(NE(K).NE.3)GO TO 11
03100 L4: ADDI L,3
03200 HRRZ T,(L)
03300 L11: SETZM (L)
03400 CAIN T,3
03500 ; NE(K)=-1
03600 SETOM (L)
03700 ; GO TO 4
03800 ; 11 NE(K)=0
03900 ; 4 CONTINUE
04000 CAIGE L,(KK)
04100 JRST L4
04200 ; RLFT=10000
04300 MOVE RL,[=10000.0]
04400 ; RT=-10000
04500 MOVN RJ,[=10000.0]
04600 ; B=RT
04700 MOVE B,RJ
04800 ; DO 12 K=1,KK
04900 HRRZI L,-3(J)
05000 ; H=IFIX(Q(K))
05100 L12: ADDI L,3
05200 MOVE H,(L)
05300 FIXX(H)
05400 FLOAT(H)
05500 ; IF(H.LT.RLFT)RLFT=H
05600 CAMGE H,RL
05700 MOVE RL,H
05800
05900 ; IF(H.GT.RT)RT=H
06000 CAMLE H,RJ
06100 MOVE RJ,H
06200 ; IF(H.EQ.B)NE(K)=-1
06300 CAMN H,B
06400 SETOM 2(L)
06500 ; B=H
06600 MOVE B,H
06700 ; Q(K)=H
06800 MOVEM H,(L)
06900 ; 12 R(K)=IFIX(R(K))
07000 MOVE T,1(L)
07100 FIXX(T)
07200 FLOAT(T)
07300 MOVEM T,1(L)
07400 CAIGE L,-2(KK)
07500 JRST L12
07600 ; NE(KK+1)=-1
07700 SETOM 3(KK)
07800
07900 ; LRT=RT
08000 FIXX(RJ)
08100 MOVEM RJ,LRT#
08200 ; JA=3
08300 HRRZI T,3
08400 HRRZM T,JA#
08500
08600
08700 ; 124 LEFT=RLFT
08800 L124: MOVE LE,RL
08900 FIXX(LE)
09000 ; 51 J=LEFT
09100 L51: MOVE J,LE
09200 ; 42 RJ=J+.001
09300 L42: MOVE RJ,J
09400 FLOAT(RJ)
09500 FADR RJ,[=0.001]
09600 ; JCONT=0
09700 SETZM JCONT#
09800 ; LEFT=J
09900 MOVE LE,J
10000
10100 ; JJ=-1
10200 SETO JJ,
10300 ; ALT=-10000.
10400 MOVN AL,[=10000.0]
10500 ; 200 DO 45 L=2,KK
10600 HRRZ L,SVQ
10700 L45: ADDI L,3
10800 CAILE L,-2(KK)
10900 JRST L455
11000 ; IF(NE(L).NE.0)GO TO 45
11100 SKIPE 2(L)
11200 JRST L45
11300 ; IF(MISS(L,RJ,Q))GO TO 45
11400 CAML RJ,-3(L)
11500 JRST L201
11600 CAMLE RJ,(L)
11700 JRST L202
11800 L201: CAMGE RJ,(L)
11900 CAMG RJ,-3(L)
12000 JRST L45
12100 ; H=HGHT(L,RJ,Q,R)
12200 L202: MOVE H,-2(L)
12300 CAMN H,1(L)
12500 JRST RET
12550 MOVNS H
12700 FADR H,1(L)
12750 MOVE D,-3(L)
12800 MOVNS T,D
12900 FADR T,RJ
13000 FADR D,(L)
13100 FMPR H,T
13200 FDVR H,D
13300 FADR H,-2(L)
13400 ; IF(H.LT.ALT)GO TO 45
13500 RET: CAMGE H,AL
13600 JRST L45
13700
13800 ; ALT=H
13900 MOVE AL,H
14000 ; JJ=L
14100 HRRZI JJ,(L)
14200 ; 45 CONTINUE
14300 JRST L45
14400 ; IF(JJ)GO TO 43
14500 L455: JUMPL JJ,L43
14600 ; JCONT=-1
14700 SETOM JCONT
14800 ; LEFT=J
14900 MOVE LE,J
15000 ; 46 JA=3
15100 L46: HRRZI T,3
15200 HRRZM T,JA
15300 ; JORD=-1
15400 SETOM JORD#
15500 ; 52 KN=Q(JJ)
15600 L52: MOVE T,(JJ)
15700 FIXX(T)
15800 MOVEM T,KN#
15900 ; KL=Q(JJ-1)
16000 MOVE T,-3(JJ)
16100 FIXX(T)
16200
16300 MOVEM T,KL#
16400 ; IF(KN.LT.KL)KN=KL
16500 CAMLE T,KN
16600 MOVEM T,KN
16700 ; 50 I=J
16800 L50: MOVEM J,I#
16900 ; 102 RJ=I+.01
17000 L102: MOVE RJ,I
17100 FLOAT(RJ)
17200 FADR RJ,[=0.01]
17300 ; ALT=HGHT(JJ,RJ,Q,R)
17400 MOVE AL,-2(JJ)
17600 CAMN AL,1(JJ)
17700 JRST RET2
17800 MOVNS AL
17900 FADR AL,1(JJ)
17950 MOVE D,-3(JJ)
18000 MOVNS T,D
18100 FADR T,RJ
18200 FADR D,(JJ)
18300 FMPR AL,T
18400 FDVR AL,D
18500 FADR AL,-2(JJ)
18600 ; B=-10000
18700 RET2: MOVN B,[=10000.0]
18800 ; JK=-1
18900 SETO JK,
19000 ; XALT=ALT+.001
19100 MOVE T,AL
19200 FADR T,[=0.001]
19300 MOVEM T,XALT#
19400
19500 ; ZALT=ALT
19600 MOVEM AL,ZALT#
19700 ; 400 DO 47 L=2,KK
19800 MOVE L,SVQ
19900 L47: ADDI L,3
20000 CAILE L,-2(KK)
20100 JRST L477
20200 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20300 CAME L,JJ
20400 SKIPGE 2(L)
20500 JRST L47
20600 CAML RJ,-3(L)
20700 JRST L475
20800 CAMLE RJ,(L)
20900 JRST L476
21000 L475: CAMGE RJ,(L)
21100 CAMG RJ,-3(L)
21200 JRST L47
21300 ; H=HGHT(L,RJ,Q,R)
21400 L476: MOVE H,-2(L)
21500 CAMN H,1(L)
21700 JRST RET3
21800 MOVNS H
21900 FADR H,1(L)
21950 MOVE D,-3(L)
22000 MOVNS T,D
22100 FADR T,RJ
22200 FADR D,(L)
22300 FMPR H,T
22400 FDVR H,D
22500 FADR H,-2(L)
22600 ; IF(H.GT.XALT)GO TO 47
22700 RET3: CAMG H,XALT
22800
22900 ; IF(H.LE.B)GO TO 47
23000 CAMG H,B
23100 JRST L47
23200 ; B=H
23300 MOVE B,H
23400 ; JK=L
23500 HRRZI JK,(L)
23600 ; 47 CONTINUE
23700 JRST L47
23800 ; IF(JK)GO TO 48
23900 L477: JUMPL JK,L48
24000 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24100 MOVN T,B
24200 FADR T,ZALT
24300 CAMG T,[=0.001]
24400 CAME J,I
24500 JRST L59
24600 ; JX=Q(JK)
24700 MOVE T,(JK)
24800 FIXX(T)
24900 ; IF(JX.GT.KN)GO TO 60
25000 CAMLE T,KN
25100 JRST L60
25200 ; JX=Q(JK-1)
25300 MOVE T,-3(JK)
25400 FIXX(T)
25500 ; IF(JX.LT.KN)GO TO 59
25600 CAMGE T,KN
25700 JRST L59
25800 ; 60 L=JJ
25900 L60: MOVE L,JJ
26000 ; JJ=JK
26100 MOVE JJ,JK
26200 ; JK=L
26300 MOVE JK,L
26400 ; KN=JX
26500 MOVEM T,KN
26600
26700 ; 59 IF(ALT-B.LT.2)GO TO 62
26800 L59: MOVN T,B
26900 FADR T,AL
27000 CAMGE T,[=2.0]
27100 JRST L62
27200 ; ALT=ALT-1
27300 HRLZI T,576400
27400 FADR AL,T
27500 ; B=B+1
27600 HRLZI T,201400
27700 FADR B,T
27800 ; 62 IF(JORD)GO TO 103
27900 L62: SKIPGE JORD
28000 JRST L103
28100 ; H=B
28200 MOVE H,B
28300 ; B=ALT
28400 MOVE B,AL
28500 ; ALT=H
28600 MOVE AL,H
28700 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28800
28900 CAMN JK,NK#
29000 JRST L103
29100 MOVN T,B
29200 FADR T,AL
29300 SKIPGE T
29400 MOVNS T
29500 CAMG T,[5.0]
29600 JRST L103
29700 HRRZI T,3
29800 HRRZM T,JA
29900 ; 103 CALL LINES(RJ,ALT,JA)
30000 L103: MOVEM RJ,SVRJ#
30100 MOVEM AL,SVAL#
30200 MOVEM B,SVB#
30300 HRRZI 16,SVAC
30400 BLT 16,SVAC+15
30500 JSA 16,LINES
30600 JUMP SVRJ
30700 JUMP SVAL
30800 JUMP JA
30900 ; 100 CALL LINES(RJ,B,2)
31000 JSA 16,LINES
31100 JUMP SVRJ
31200 JUMP SVB
31300 JUMP [2]
31400 HRLZI 16,SVAC
31500 BLT 16,15
31600 ; NK=JK
31700 MOVEM JK,NK
31800
31900 ; JORD=-JORD
32000 MOVNS JORD
32100 ; NE(JK)=1
32200 HRRZI T,1
32300 HRRZM T,2(JK)
32400 ; NE(JJ)=-1
32500 SETOM 2(JJ)
32600 ; JA=2
32700 HRRZI T,2
32800 HRRZM T,JA
32900 ; I=I+M
33000 MOVE T,SVM
33100 ADDB T,I
33200 ; IF(I.LT.KN)GO TO 102
33300 CAMGE T,KN
33400 JRST L102
33500 ; L=1
33600 HRRZI L,3
33700 ; IF(KN.EQ.KL)L=-1
33800 MOVE T,KN
33900 CAMN T,KL
34000 HRROI L,-3
34100 ; JJ=JJ+L
34200 ADD JJ,L
34300 ; J=0
34400 SETZ J,
34500 ; IF(L)J=-1
34600 SKIPGE L
34700 HRROI J,-3
34800 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34900 SKIPN 2(JJ)
35000 CAILE JJ,-2(KK)
35100 JRST L124
35200 ADD T,SVM
35250 FLOAT(T)
35300 HRRZI HG,(JJ)
35400 ADD HG,J
35500 CAMLE T,(HG)
35600 JRST L124
35700 ; J=I
35800 MOVE J,I
35900 ; GO TO 52
36000 JRST L52
36100 ; 48 JA=3
36200 L48: HRRZI T,3
36300 HRRZM T,JA
36400 ; 43 J=LEFT+M
36500 L43: MOVE J,LE
36600 ADD J,SVM
36700 ; IF(J.LE.LRT)GO TO 42
36800 CAMG J,LRT
36900 JRST L42
37000 ; IF(JCONT)GO TO 51
37100 SKIPGE JCONT
37200 JRST L51 ; END
37410 MOVE 16,SV16
37600 JRA 16,2(16)
37610 SVAC: BLOCK 16
37700
37800 EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT,PLOT,.COMM.
37900 ; SUBROUTINE LINES(A,B,L)
38000 ; COMMON/DST/BB,CC
38100 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38200 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38300 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38400 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600 ; 1,(JJ2,JJ(2))
38700 ; DATA BB/.008/,CC/3.5/
38800 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900
39000 DEFINE ABS(N)
39100 < SKIPGE N
39200 MOVNS N >
39300 M←2 ↔ N←3 ↔ K←4
39400
39500 LINES: 0
39600 ; GO TO 23
39700 JRST L23
39800 ;22 IF(JQ(1).NE.0)GO TO 23
39900 L22: SKIPE PLTR+=27
40000 JRST L23
40100 ; IF(CC.EQ.1000)GO TO 23
40200 MOVSI T,212764
40300 CAMN T,DST+1
40400 JRST L23
40500 ; B=B*(CC-BB*ABS(A))
40600 MOVE T,@(16)
40700 ABS(T)
40800 FMPR T,DST
40900 FSBR T,DST+1
41000 FMPRM T,@1(16)
41100 MOVNS @1(16)
41200 ;23 IF(IPLT)GO TO 2
41300 L23: SKIPGE PLTR
41400 JRST L2
41500 ; M=A*RSZ
41600 MOVE M,@(16)
41700 FMPR M,SIZ
41800 FIXX(M)
41900 ; N=B*RSZ
42000 MOVE N,@1(16)
42100 FMPR N,SIZ
42200 FIXX(N)
42300 ; IF(RSZ.LE.0.8571)GO TO 3
42400 MOVE T,[=0.8571]
42500 CAML T,SIZ
42600 JRST L3
42700
42800 ; M=M-JCEN
42900 SUB M,SIZ+1
43000 ; N=N-KCEN
43100 SUB N,SIZ+2
43200 ; IF(JA.NE.8)GO TO 5
43300 MOVEI T,10
43400 CAME T,.COMM.+1
43500 JRST L5
43600 ; IF(M.GT.511)M=511
43700 CAMLE M,[=511]
43800 HRRZI M,=511
43900 ; IF(M.LT.-511)M=-511
44000 CAMGE M,[-=511]
44100 HRROI M,-=511
44200 ;5 IF(IABS(M).GT.512)GO TO 77
44300 L5: CAIG M,=512
44400 CAMGE M,[-=512]
44500 JRST L77
44600 ; IF(IABS(N).LT.512)GO TO 4
44700 CAIGE N,=512
44800 CAMG N,[-=512]
44900 CAIA
45000 JRST LL4
45100 ;77 KZ=-1
45200 L77: SETOM KZ#
45300 ; RETURN
45400 JRA 16,3(16)
45500 ;4 IF(KZ.EQ.0)GO TO 6
45600 LL4: SKIPN KZ
45700 JRST L6
45800 ; KZ=0
45900 SETZM KZ
46000 MOVEM M,MM# ; GO TO 1
46100 MOVEM N,NN#
46200 JRST L1
46300 ;3 IF(JA.EQ.44)GO TO 6
46400 L3: MOVEI T,54
46500 CAMN T,.COMM.+1
46600 JRST L6
46700 ; K=B
46800 MOVE K,@1(16)
46900 FIXX(K)
47000 ; IF(K.GT.ITOP)ITOP=B
47100 CAMG K,DPY+=3998
47200 JRST L333
47300 MOVE T,@1(16)
47400 FIXX(T)
47500 MOVEM T,DPY+=3998
47600
47700 ; IF(K.LT.IBOT)IBOT=B
47800 L333: CAML K,DPY+=3999
47900 JRST L6
48000 MOVE T,@1(16)
48100 FIXX(T)
48200 MOVEM T,DPY+=3999
48300 ;6 IF(JJ2.GT.3990)RETURN
48400 L6: MOVEI T,7626
48500 CAMGE T,DPY+1
48600 JRA 16,3(16)
48700 ; IF(L.EQ.3)GO TO 1
48800 MOVEM M,MM
48900 MOVEM N,NN
49000 HRRZI T,3
49100 CAMN T,@2(16)
49200 JRST L1
49300 ; CALL AVECT(M,N)
49400 JSA 16,AVECT
49500 JUMP MM
49600 JUMP NN
49700 ; RETURN
49800 JRA 16,3(16)
49900 ;1 CALL AIVECT(M,N)
50000 L1: JSA 16,AIVECT
50100 JUMP MM
50200 JUMP NN
50300 ; RETURN
50400 JRA 16,3(16)
50500 ;2 IF(IPLT.EQ.-2)RETURN
50600 L2: MOVNI T,2
50700 CAMN T,PLTR
50800 JRA 16,3(16)
50900 ;9 M=ROFF(A*DIS)
51000 L9: MOVE M,@(16)
51100 FMPR M,PLTR+2
51200 SKIPGE M
51300 FADR M,[-=1.0]
51400 FADR M,[=0.5]
51500 FIXX(M)
51600 MOVEM M,MM
51700 ; N=ROFF(B*RHT)
51800 MOVE N,@1(16)
51900 FMPR N,PLTR+1
52000 SKIPGE N
52100 FADR N,[-=1.0]
52200 FADR N,[=0.5]
52300 FIXX(N)
52400 MOVEM N,NN
52500 ;8 CALL PLOT(M,N,L)
52600 L8: MOVE T,@2(16)
52700 MOVEM T,LL#
52800 JSA 16,PLOT
52900 JUMP MM
53000 JUMP NN
53100 JUMP LL
53200 ; END
53300 JRA 16,3(16)
55400 END